////////////////////////////////////////////////////////////////////////////
// PaxCompiler
// Site: http://www.paxcompiler.com
// Author: Alexander Baranovsky (paxscript@gmail.com)
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2006-2011. All rights reserved.
// Code Version: 3.1
// ========================================================================
// Unit: PAXCOMP_2010REG.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////

{$I PaxCompiler.def}
{$O-}
unit PAXCOMP_2010REG;
interface
{$ifdef DRTTI}
uses
  Classes,
  SysUtils,
  TypInfo,
  Variants,
  RTTI,
  PAXCOMP_CONSTANTS,
  PAXCOMP_SYS,
  PAXCOMP_2010,
  PAXCOMP_BASESYMBOL_TABLE,
  PAXCOMP_CLASSLST,
  PAXCOMP_STDLIB;

function RegisterType(Level: Integer; t: TRTTIType;
                      SymbolTable: TBaseSymbolTable): Integer;
function RegisterField(Level: Integer; f: TRTTIField;
                        SymbolTable: TBaseSymbolTable): Integer;
function RegisterMethod(Level: Integer; m: TRTTIMethod;
                        SymbolTable: TBaseSymbolTable): Integer;
function RegisterRecordType(Level: Integer; t: TRTTIRecordType;
                            SymbolTable: TBaseSymbolTable): Integer;
function RegisterClassType(Level: Integer; t: TRTTIInstanceType;
                           SymbolTable: TBaseSymbolTable): Integer;
function RegisterInterfaceType(Level: Integer; t: TRTTIInterfaceType;
                               SymbolTable: TBaseSymbolTable): Integer;
function RegisterArrayType(Level: Integer; t: TRTTIArrayType;
                            SymbolTable: TBaseSymbolTable): Integer;
function RegisterDynamicArrayType(Level: Integer; t: TRTTIDynamicArrayType;
                                  SymbolTable: TBaseSymbolTable): Integer;
function RegisterPointerType(Level: Integer; t: TRTTIPointerType;
                                  SymbolTable: TBaseSymbolTable): Integer;
function RegisterClassRefType(Level: Integer; t: TRTTIClassRefType;
                              SymbolTable: TBaseSymbolTable): Integer;
function RegisterProceduralType(Level: Integer; t: TRTTIProcedureType;
                                SymbolTable: TBaseSymbolTable): Integer;
procedure RegisterUnit(AUnit: TUnit; SymbolTable: TBaseSymbolTable);
procedure RegisterUnits(UnitList: TUnitList; SymbolTable: TBaseSymbolTable); overload;
procedure RegisterUnits(UnitList: TUnitList); overload;

// Added event to provide a header for known methods that have no RTTI extended info
// It is necessary to register some functions with 'array of const' parameters.
type
  TGetMethodHeaderEvent = procedure(var aHeader: string; aMethod: TRttiMethod) of object;
  PTValue = ^TValue;
var
  OnMethodHasNoExtendedInfo: TGetMethodHeaderEvent;

procedure InitializePAXCOMP_2010Reg;
procedure _VarFromTValue(V: PTValue; T: Integer; ResAddr: Pointer);
stdcall;

implementation

// Added unit to support indexed properties.
{$IFDEF DPULSAR}
uses
  System.Generics.Collections;
{$ENDIF}

function CheckField(t: TRTTIType; f: TRTTIField): Boolean;
begin
  result := false;

  if not CheckType(f.FieldType) then
    Exit;

  if not (f.Visibility in [mvPublic]) then
    Exit;

  if f.Parent <> t then
    Exit;

  result := true;
end;

function CheckMethod(t: TRTTIType; m: TRTTIMethod): Boolean;
var
  param: TRttiParameter;
begin
  result := false;

  if not (m.Visibility in [mvPublic, mvPublished]) then
    Exit;

  if not m.HasExtendedInfo then
    Exit;

  // Class constructors and class destructor should not be registered. They are called by the application.
  if m.MethodKind in [mkClassConstructor, mkClassDestructor] then
    Exit;

  if m.IsClassMethod and m.IsStatic then
    Exit;

  if assigned(m.ReturnType) then
    if not CheckType(m.ReturnType) then
      Exit;

  for param in m.GetParameters() do
    if not CheckType(param.ParamType) then
      Exit;

  if m.Parent <> t then
  if not (m.DispatchKind in [dkVtable, dkDynamic]) then
    Exit;

  result := true;
end;

function CheckProperty(t: TRTTIType; p: TRTTIProperty): Boolean;
begin
  result := false;

  if not CheckType(p.PropertyType) then
    Exit;

  if not (p.Visibility in [mvPublic]) then
    Exit;

  if not p.Parent.InheritsFrom(t.ClassType) then
    Exit;

  result := true;
end;

// Added function to support indexed properties.
function CheckIndexedPropertyMethod(aRttiType: TRTTIType; aMethod: TRTTIMethod): Boolean;
var
  param: TRttiParameter;
begin
  Result := False;
  if not aMethod.HasExtendedInfo then
    Exit;

  if Assigned(aMethod.ReturnType) then
    if not CheckType(aMethod.ReturnType) then
      Exit;

  if aMethod.IsClassMethod and aMethod.IsStatic then
    Exit;

  for Param in aMethod.GetParameters() do
    if not CheckType(param.ParamType) then
      Exit;

  if aMethod.Parent <> aRttiType then
    if not (aMethod.DispatchKind in [dkVtable, dkDynamic]) then
      Exit;

  Result := True;
end;

{$IFDEF DPULSAR}
// Added function to support indexed properties.
function CheckIndexedProperty(aRttiType: TRTTIType; aIndexedProperty: TRTTIIndexedProperty): Boolean;
begin
  Result := False;
  if not CheckType(aIndexedProperty.PropertyType) then
    Exit;
  if not (aIndexedProperty.Visibility in [mvPublic]) then
    Exit;
  if not aIndexedProperty.Parent.InheritsFrom(aRttiType.ClassType) then
    Exit;
  if aIndexedProperty.IsReadable then
    if not CheckIndexedPropertyMethod(aRttiType, aIndexedProperty.ReadMethod) then
      Exit;
  if aIndexedProperty.IsWritable then
    if not CheckIndexedPropertyMethod(aRttiType, aIndexedProperty.WriteMethod) then
      Exit;
  Result := True;
end;

// Added function to support indexed properties.
function GetIndexedPropertyDecl(aProperty: TRttiIndexedProperty): string;
var
  Method: TRTTIMethod;
  Param: TRttiParameter;
  ParamCount, I: Integer;
begin
  if aProperty.IsReadable then begin
    Method := aProperty.ReadMethod;
    ParamCount := Length(Method.GetParameters);
  end else if aProperty.IsWritable then begin
    Method := aProperty.WriteMethod;
    ParamCount := Length(Method.GetParameters) - 1;
  end else begin
    Method := nil;
    ParamCount := 0;
  end;

  Result := 'property ' + aProperty.Name + '[';
  for I := 0 to ParamCount - 1 do begin
    Param := Method.GetParameters[I];
    if I > 0 then
      Result := Result + '; ';
    Result := Result + Param.Name + ': ' + Param.ParamType.Name;
  end;
  Result := Result + ']: ' + aProperty.PropertyType.Name;
  if aProperty.IsReadable then
    Result := Result + ' read ' + aProperty.ReadMethod.Name;
  if aProperty.IsWritable then
    Result := Result + ' write ' + aProperty.WriteMethod.Name;
  Result := Result + ';';
  if aProperty.IsDefault then
    Result := Result + ' default;';
end;
{$ENDIF}

function RegisterField(Level: Integer; f: TRTTIField;
                       SymbolTable: TBaseSymbolTable): Integer;
var
  S: String;
  TypeId: Integer;
  t: TRTTIType;
begin
  with SymbolTable do
  begin
    t := f.FieldType;
    S := t.Name;
    TypeId := LookUpType(S, true);
    if TypeId = 0 then
       ExternList.Add(Card + 1, S, erTypeId);
    result := RegisterTypeField(Level, f.Name, TypeId, f.Offset);
  end;
end;

function RegisterMethod(Level: Integer; m: TRTTIMethod;
                        SymbolTable: TBaseSymbolTable): Integer;
var
  S: String;
  cc: Integer;
  CallMode: Integer;
  MethodIndex: Integer;
  TypeId: Integer;
  C: TClass;
  SubId: Integer;
  K: Integer;
  param: TRttiParameter;
  CodeAddress: Pointer;
begin
  result := 0;
  if not (m.Parent is TRttiInstanceType) then
    Exit;

  C := (m.Parent as TRttiInstanceType).MetaClassType;

  //with SymbolTable do
  //begin
    S := '';

    if m.ReturnType = nil then
      typeId := typeVOID
    else
    begin
      S := m.ReturnType.Name;
      typeId := SymbolTable.LookUpType(S, true);
      // Moved test inside if-statement.
      if TypeId = 0 then
         SymbolTable.ExternList.Add(SymbolTable.Card + 1, S, erTypeId);
    end;

    cc := PAXCOMP_CONSTANTS.ccREGISTER;
    case m.CallingConvention of
      TypInfo.ccReg: cc := PAXCOMP_CONSTANTS.ccREGISTER;
      TypInfo.ccCdecl: cc := PAXCOMP_CONSTANTS.ccCDECL;
      TypInfo.ccPascal: cc := PAXCOMP_CONSTANTS.ccPASCAL;
      TypInfo.ccStdCall: cc := PAXCOMP_CONSTANTS.ccSTDCALL;
      TypInfo.ccSafeCall: cc := PAXCOMP_CONSTANTS.ccSAFECALL;
    end;

    // Set CallMode, MethodIndex and CodeAddress all at once.
    // Note that for cases dkVTable and dkDynamic m.CodeAddress returns an incorrect value. Therefore the code address
    // is read from the virtual / dynamic method table using m.VirtualIndex.
    CallMode := cmNONE;
    MethodIndex := 0;
    CodeAddress := m.CodeAddress;
    case m.DispatchKind of
      dkStatic: ;
      dkVtable:
        begin
          CallMode := cmVIRTUAL;
          MethodIndex := m.VirtualIndex;
          CodeAddress := PPointerArray(C)[MethodIndex];
          if MethodIndex >= 0 then
            Inc(MethodIndex);
        end;
      dkDynamic:
        begin
          CallMode := cmDYNAMIC;
          CodeAddress := GetDynaMethod(C, m.VirtualIndex);
        end;
      dkMessage: CallMode := cmDYNAMIC;
      dkInterface: ;
    end;

    // Use CodeAddress instead of m.CodeAddress.
    if m.IsConstructor then begin
      result := SymbolTable.RegisterConstructor(Level, m.Name, CodeAddress, CallMode);
      SymbolTable.Records[SymbolTable.LastSubId].MethodIndex := MethodIndex;
    end else if m.IsDestructor then
    begin
      result := SymbolTable.RegisterMethod(Level, m.Name, TypeId, cc, CodeAddress, false, CallMode, MethodIndex);
      SymbolTable.Records[SymbolTable.LastSubId].Kind := kindDESTRUCTOR;
    end
    else
      result := SymbolTable.RegisterMethod(Level, m.Name, TypeId, cc, CodeAddress, m.IsClassMethod, CallMode, MethodIndex);

    case m.Visibility of
      mvPrivate:   SymbolTable.Records[SymbolTable.LastSubId].Vis := cvPrivate;
      mvProtected: SymbolTable.Records[SymbolTable.LastSubId].Vis := cvProtected;
      mvPublic:    SymbolTable.Records[SymbolTable.LastSubId].Vis := cvPublic;
      mvPublished: SymbolTable.Records[SymbolTable.LastSubId].Vis := cvPublished;
    end;

    // MethodIndex was already set correctly.
    {MethodIndex := VirtualMethodIndex(PPointerArray(C), m.CodeAddress) + 1;
    if MethodIndex > 0 then
      SymbolTable.Records[SymbolTable.LastSubId].MethodIndex := MethodIndex
    else if m.CodeAddress = nil then
      SymbolTable.Records[SymbolTable.LastSubId].CallMode := cmNONE;}

    // Changed test. cmOVERRIDE is never set.
    //if CallMode in [cmDYNAMIC, cmOVERRIDE] then
    if CallMode = cmDYNAMIC then
      SymbolTable.Records[SymbolTable.LastSubId].DynamicMethodIndex := m.VirtualIndex;

    SubId := SymbolTable.LastSubId;
    K := 0;
    for param in m.GetParameters() do
    begin

      if param.ParamType = nil then
        typeID := typeVOID
      else
      begin
        S := param.ParamType.Name;
        typeId := SymbolTable.LookUpType(S, true);
        if TypeId = 0 then
        begin
          SymbolTable.ExternList.Add(SymbolTable.Card + 1, S, erTypeId);
        end;
      end;

      SymbolTable.RegisterParameter(result, TypeId, Unassigned, false, param.Name, 0);

      if [pfVar, pfReference, pfOut] * Param.Flags <> [] then
        SymbolTable.Records[SymbolTable.Card].ByRef := true;
      if pfConst in param.Flags then
        SymbolTable.Records[SymbolTable.Card].IsConst := true;
      if pfArray in param.Flags then
        SymbolTable.Records[SymbolTable.Card].IsOpenArray := true;

      Inc(K);
    end;

    SymbolTable.Records[SubId].Count := K;
  //end; // with SymbolTable
end;

function RegisterRecordType(Level: Integer; t: TRTTIRecordType;
                            SymbolTable: TBaseSymbolTable): Integer;
var
  m: TRTTIMethod;
  f: TRTTIField;
begin
  result := SymbolTable.RegisterRecordType(Level,
                                           t.Name, GlobalAlignment);
  for f in t.GetFields do
    if CheckField(t, f) then
      RegisterField(result, f, SymbolTable);
  for m in t.GetDeclaredMethods do
    if CheckMethod(t, m) then
      RegisterMethod(Result, m, SymbolTable);
end;

{$IFDEF DPULSAR}
function RegisterClassType(Level: Integer; t: TRTTIInstanceType;
                           SymbolTable: TBaseSymbolTable): Integer;
var
  m: TRTTIMethod;
  f: TRTTIField;
  C: TClass;
  IndexedProp: TRTTIIndexedProperty;
  RegisteredMethods: TList<TRttiMethod>;
  Index, MethodIndex: Integer;
  Decl, Header: string;
begin
  C := (t as TRttiInstanceType).MetaclassType;
  result := SymbolTable.RegisterClassType(Level, C);
  for f in t.GetDeclaredFields do
    if CheckField(t, f) then
      RegisterField(result, f, SymbolTable);

  // Store registered methods in a local list to be used during registration of indexed properties.
  RegisteredMethods := TList<TRttiMethod>.Create();
  try
    for m in t.GetDeclaredMethods do begin
      if m.HasExtendedInfo then begin
        if CheckMethod(t, m) then begin
          RegisterMethod(Result, m, SymbolTable);
          // Add method to list.
          RegisteredMethods.Add(m);
        end;
      end else begin
        // Call an event to provide a header for known methods that have no RTTI extended info.
        if (m.Visibility in [mvPublic, mvPublished]) and Assigned(OnMethodHasNoExtendedInfo) then begin
          Header := '';
          OnMethodHasNoExtendedInfo(Header, m);
          if Header <> '' then begin
            MethodIndex := 0;
            if m.DispatchKind = dkVtable then
              MethodIndex := m.VirtualIndex;
            SymbolTable.RegisterHeader(Result, Header, m.CodeAddress, MethodIndex);
          end;
        end;
      end;
    end;

    // Added support for indexed properties.
    for IndexedProp in t.GetDeclaredIndexedProperties do begin
      if CheckIndexedProperty(t, IndexedProp) then begin
        if IndexedProp.IsReadable then begin
          Index := RegisteredMethods.IndexOf(IndexedProp.ReadMethod);
          if Index = -1 then begin
            RegisterMethod(Result, IndexedProp.ReadMethod, SymbolTable);
            RegisteredMethods.Add(IndexedProp.ReadMethod);
          end;
        end;
        if IndexedProp.IsWritable then begin
          Index := RegisteredMethods.IndexOf(IndexedProp.WriteMethod);
          if Index = -1 then begin
            RegisterMethod(Result, IndexedProp.WriteMethod, SymbolTable);
            RegisteredMethods.Add(IndexedProp.WriteMethod);
          end;
        end;
        Decl := GetIndexedPropertyDecl(IndexedProp);
        SymbolTable.RegisterHeader(Result, Decl, nil);
      end;
    end;
  finally
    RegisteredMethods.Free;
  end;
end;
{$ELSE}
function RegisterClassType(Level: Integer; t: TRTTIInstanceType;
                           SymbolTable: TBaseSymbolTable): Integer;
var
  m: TRTTIMethod;
  f: TRTTIField;
  C: TClass;
begin
  C := (t as TRttiInstanceType).MetaclassType;
  result := SymbolTable.RegisterClassType(Level, C);
  for f in t.GetDeclaredFields do
    if CheckField(t, f) then
      RegisterField(result, f, SymbolTable);
  for m in t.GetDeclaredMethods do
    if m.HasExtendedInfo then
      if CheckMethod(t, m) then
      begin
        RegisterMethod(result, m, SymbolTable);
      end;
end;
{$ENDIF}


function RegisterInterfaceType(Level: Integer; t: TRTTIInterfaceType;
                               SymbolTable: TBaseSymbolTable): Integer;
var
  m: TRTTIMethod;
  f: TRTTIField;
  S: String;
begin
  S := t.Name;

  result := SymbolTable.RegisterInterfaceType(Level, S, t.guid);
  for f in t.GetFields do
    if CheckField(t, f) then
      RegisterField(result, f, SymbolTable);
  for m in t.GetMethods do
    if m.HasExtendedInfo then
      if CheckMethod(t, m) then
        RegisterMethod(result, m, SymbolTable);
end;

function RegisterArrayType(Level: Integer; t: TRTTIArrayType;
                           SymbolTable: TBaseSymbolTable): Integer;
var
  I, K, HR, HE, Align: Integer;
  S: String;
begin
  Align := GlobalAlignment;
  K := t.DimensionCount;
  result := 0;
  for I := 0 to K - 1 do
  begin
    if t.Dimensions[I] = nil then
    begin
      result := 0;
      Exit;
    end;

    HR := RegisterType(Level, t.Dimensions[I], SymbolTable);
    if I = 0 then
      HE := RegisterType(Level, t.ElementType, SymbolTable)
    else
      HE := result;
    if I = K - 1 then
      S := t.Name
    else
      S := 'Array_' + IntToStr(SymbolTable.Card + 1);
    result := SymbolTable.RegisterArrayType(Level, S, HR, HE, Align);
  end;
end;

function RegisterDynamicArrayType(Level: Integer; t: TRTTIDynamicArrayType;
                                  SymbolTable: TBaseSymbolTable): Integer;
var
  H: Integer;
begin
  H := RegisterType(Level, t.ElementType, SymbolTable);
  result := SymbolTable.RegisterDynamicArrayType(Level, t.Name, H);
end;

function RegisterPointerType(Level: Integer; t: TRTTIPointerType;
                             SymbolTable: TBaseSymbolTable): Integer;
var
  H: Integer;
begin
  H := RegisterType(Level, t.ReferredType, SymbolTable);
  result := SymbolTable.RegisterPointerType(Level, t.Name, H);
end;

function RegisterClassRefType(Level: Integer; t: TRTTIClassRefType;
                              SymbolTable: TBaseSymbolTable): Integer;
var
  H: Integer;
begin
  H := RegisterType(Level, t.InstanceType, SymbolTable);
  result := SymbolTable.RegisterClassReferenceType(Level, t.Name, H);
end;

function RegisterProceduralType(Level: Integer; t: TRTTIProcedureType;
                               SymbolTable: TBaseSymbolTable): Integer;
begin
  result := SymbolTable.RegisterPointerType(Level, t.Name, typeVOID);
end;

function RegisterType(Level: Integer; t: TRTTIType;
                      SymbolTable: TBaseSymbolTable): Integer;
var
  S: String;
begin
  result := 0;
  if t = nil then
    Exit;
  S := t.Name;
  {$IFDEF DEBUG}
  if S = 'TMyBase' then
    Result := 0;
  {$ENDIF}
  result := SymbolTable.LookUpType(S, true);
  if result > 0 then
    Exit;
  case t.TypeKind of
    tkRecord:
      result := RegisterRecordType(Level, t as TRTTIRecordType, SymbolTable);
    tkClass:
      result := RegisterClassType(Level, t as TRTTIInstanceType, SymbolTable);
    tkInterface:
      result := RegisterInterfaceType(Level, t as TRTTIInterfaceType, SymbolTable);
    tkArray:
      result := RegisterArrayType(Level, t as TRTTIArrayType, SymbolTable);
    tkDynArray:
      result := RegisterDynamicArrayType(Level, t as TRTTIDynamicArrayType, SymbolTable);
    tkPointer:
      result := RegisterPointerType(Level, t as TRTTIPointerType, SymbolTable);
    tkProcedure:
      result := RegisterProceduralType(Level, t as TRTTIProcedureType, SymbolTable);
    tkClassRef:
      result := RegisterClassRefType(Level, t as TRTTIClassRefType, SymbolTable);
    else
      result := SymbolTable.RegisterRTTIType(Level, t.Handle);
  end;
end;

procedure RegisterUnit(AUnit: TUnit; SymbolTable: TBaseSymbolTable);
var
  I, L: Integer;
begin
  L := SymbolTable.RegisterNamespace(0, AUnit.Name);
  for I := 0 to AUnit.Count - 1 do
    RegisterType(L, AUnit[I].T, SymbolTable);
end;

procedure RegisterUnits(UnitList: TUnitList; SymbolTable: TBaseSymbolTable);
var
  I: Integer;
begin
  for I := 0 to UnitList.Count - 1 do
    RegisterUnit(UnitList[I], SymbolTable);
  for I := 0 to UnitList.ForbiddenClasses.Count - 1 do
    SymbolTable.HideClass(TClass(UnitList.ForbiddenClasses[I]));
end;

procedure RegisterUnits(UnitList: TUnitList);
var
  I: Integer;
begin
  for I := 0 to UnitList.Count - 1 do
    RegisterUnit(UnitList[I], GlobalImportTable);
end;


// TValue ---------

function TValue_Implicit_String(const Value: string): TValue;
begin
  result := Value;
end;

function TValue_Implicit_Integer(Value: Integer): TValue;
begin
  result := Value;
end;

function TValue_Implicit_Extended(Value: Extended): TValue;
begin
  result := Value;
end;

function TValue_Implicit_Int64(Value: Int64): TValue;
begin
  result := Value;
end;

function TValue_Implicit_TObject(Value: TObject): TValue;
begin
  result := Value;
end;

function TValue_Implicit_TClass(Value: TClass): TValue;
begin
  result := Value;
end;

function TValue_Implicit_Boolean(Value: Boolean): TValue;
begin
  result := Value;
end;

function TValue_GetDataSize(Self: TValue): Integer;
begin
  result := Self.DataSize;
end;

procedure _VarFromTValue(V: PTValue; T: Integer; ResAddr: Pointer);
stdcall;
begin
  case T of
    typeENUM: Integer(ResAddr^) := V.AsOrdinal;
    typeINTEGER: Integer(ResAddr^) := V.AsInteger;
    typeBYTE: Byte(ResAddr^) := V.AsInteger;
    typeWORD: Word(ResAddr^) := V.AsInteger;
    typeINT64: Int64(ResAddr^) := V.AsInt64;
    typeCARDINAL: Cardinal(ResAddr^) := V.AsInt64;
    typeSMALLINT: SmallInt(ResAddr^) := V.AsInteger;
    typeSHORTINT: ShortInt(ResAddr^) := V.AsInteger;

    typeBOOLEAN: Boolean(ResAddr^) := V.AsBoolean;
    typeWORDBOOL: WordBool(ResAddr^) := V.AsBoolean;
    typeLONGBOOL: LongBool(ResAddr^) := V.AsBoolean;
    typeBYTEBOOL: ByteBool(ResAddr^) := V.AsBoolean;

    typeANSISTRING: AnsiString(ResAddr^) := AnsiString(V.AsString);
    typeWIDESTRING: WideString(ResAddr^) := V.AsString;
    typeUNICSTRING: UnicString(ResAddr^) := V.AsString;
    typeSHORTSTRING: ShortString(ResAddr^) := AnsiString(V.AsString);

    typeDOUBLE: Double(ResAddr^) := V.AsExtended;
    typeSINGLE: Single(ResAddr^) := V.AsExtended;
    typeEXTENDED: Extended(ResAddr^) := V.AsExtended;
    typeCURRENCY: Currency(ResAddr^) := V.AsExtended;

    typeANSICHAR: AnsiChar(ResAddr^) := AnsiChar(V.AsOrdinal);
    typeWIDECHAR: WideChar(ResAddr^) := WideChar(V.AsOrdinal);

    typeCLASS: TObject(ResAddr^) := V.AsObject;
    typeCLASSREF: TClass(ResAddr^) := V.AsClass;
    typeINTERFACE: IInterface(ResAddr^) := V.AsInterface;
  else
  begin
    V.ExtractRawData(ResAddr);
  end;
  end;
end;

procedure _TValueToObject(var V: TValue; var result: TObject); stdcall;
begin
  result := V.AsObject;
end;

procedure _GetDRTTIProperty(p: TRTTIProperty;
                            X: TObject;
                            var Result: TValue); stdcall;
begin
  result := p.GetValue(X);
end;

procedure _GetDRTTIIntegerProperty(p: TRTTIProperty;
                                   X: TObject;
                                   var Result: Integer); stdcall;
begin
  result := p.GetValue(X).AsInteger;
end;

procedure _GetDRTTIStringProperty(p: TRTTIProperty;
                                  X: TObject;
                                  var Result: String); stdcall;
begin
  result := p.GetValue(X).AsString;
end;

procedure _GetDRTTIExtendedProperty(p: TRTTIProperty;
                                    X: TObject;
                                    var Result: Extended); stdcall;
begin
  result := p.GetValue(X).AsExtended;
end;

procedure _GetDRTTIVariantProperty(p: TRTTIProperty;
                                   X: TObject;
                                   var Result: Variant); stdcall;
begin
  result := p.GetValue(X).AsVariant;
end;

procedure _GetDRTTIInt64Property(p: TRTTIProperty;
                                   X: TObject;
                                   var Result: Int64); stdcall;
begin
  result := p.GetValue(X).AsOrdinal;
end;

procedure _SetDRTTIProperty(p: TRTTIProperty;
                            X: TObject;
                            var Value: TValue); stdcall;
var
  i: Int64;
begin
  if p.PropertyType.Handle.Kind = tkEnumeration then
  begin
    if Value.IsType<Boolean> then
      i := Integer(Value.AsBoolean)
    else
      i := Value.AsInteger;
    Value := TValue.FromOrdinal(p.PropertyType.Handle, i);
    p.SetValue(X, Value);
  end
  else
    p.SetValue(X, Value);
end;

function RegisterProperty(ALevel: Integer;
                          p: TRTTIProperty;
                          Index: Integer;
                          SymbolTable: TBaseSymbolTable): Integer;
var
  S: String;
  T: Integer;
  typ: TRTTIType;
begin
  with SymbolTable do
  begin
    if p = nil then
    begin
      with AddRecord do
      begin
        Name := '';
        Kind := KindPROP;
        TypeID := 0;
        Host := true;
        Shift := 0;
        Level := ALevel;
        IsPublished := false;
        IsDRTTI := true;
        PropIndex := Index;

        result := Card;
      end;
      Exit;
    end;

    typ := p.PropertyType;
    S := typ.Name;
    T := LookUpType(S, true);
    if T = 0 then
       ExternList.Add(Card + 1, S, erTypeId);

    with AddRecord do
    begin
      Name := p.Name;
      Kind := KindPROP;
      TypeID := T;
      Host := true;
      Shift := 0;
      Level := ALevel;
      IsPublished := false;
      IsDRTTI := true;
      PropIndex := Index;

      result := Card;
    end;
  end;
end;

procedure RegisterDRTTIPropertiesImpl(Level: Integer;
                                      C: TClass;
                                      SymbolTable: TBaseSymbolTable);

  function PublishedPropertyCount: Integer;
  var
    pti: PTypeInfo;
    ptd: PTypeData;
  begin
    result := 0;
    pti := C.ClassInfo;
    if pti = nil then Exit;
    ptd := GetTypeData(pti);
    result := ptd^.PropCount;
  end;

var
  I, K, LastPropertyIndex: Integer;
  p: TRTTIProperty;
  t: TRTTIType;
begin
  if IsPaxClass(C) then
  begin
    SymbolTable.RegisterClassTypeInfos(Level,C);
    Exit;
  end;

  t := PaxContext.GetType(C.ClassInfo);
  LastPropertyIndex := PublishedPropertyCount;
  K := 0;

  for p in t.GetDeclaredProperties do
  begin
    if CheckProperty(t, p) then
    begin
      if SymbolTable.Lookup(p.Name, Level, true, MaxInt, false) = 0 then
      begin
        RegisterProperty(Level, p, K + LastPropertyIndex, SymbolTable);
      end
      else
      begin
        RegisterProperty(Level, nil, K + LastPropertyIndex, SymbolTable);
      end;
      Inc(K);
    end;
  end;

  for I:=1 to K do
    SymbolTable.AddPointerVar(0);
end;

// Added this function to get the namespace of a type.
function GetNamespaceOfTypeImpl(aSymbolTable: TBaseSymbolTable; aTypeInfo: PTypeInfo): Integer;
var
  T: TRttiType;
  Namespace: string;
begin
  Result := 0;
  T := PaxContext.GetType(aTypeInfo);
  if Assigned(T) then begin
    Namespace := ExtractOwnerUnitScope(T);
    Result := aSymbolTable.LookupNamespace(Namespace, 0, True);
  end;
end;

procedure AddPropInfosDRTTIImpl(C:TClass; PropInfos: TPropList);
var
  p: TRTTIProperty;
  t: TRTTIType;
  LastOffset: Integer;
begin
  if isPaxClass(C) then
    exit;
  if PropInfos.Count = 0 then
    LastOffset := 0
  else
    LastOffset := PropInfos.Top.PropOffset + SizeOf(Pointer);

  t := PaxContext.GetType(C.ClassInfo);
  for p in t.GetDeclaredProperties do
    if CheckProperty(t, p) then
    begin
      PropInfos.Add(p, LastOffset);
      Inc(LastOffset, SizeOf(Pointer));
    end;
end;

procedure Import_TValueImpl(Level: Integer; SymbolTable: TBaseSymbolTable);
var
  H: Integer;
begin
  with SymbolTable do
  begin
    RegisterRoutine(0, '', typeVOID, ccSTDCALL, @_VarFromTValue);
    Id_VarFromTValue := LastSubId;
    RegisterRoutine(0, '', typeVOID, ccSTDCALL, @_GetDRTTIProperty);
    Id_GetDRTTIProperty := LastSubId;
    RegisterRoutine(0, '', typeVOID, ccSTDCALL, @_GetDRTTIIntegerProperty);
    Id_GetDRTTIIntegerProperty := LastSubId;
    RegisterRoutine(0, '', typeVOID, ccSTDCALL, @_GetDRTTIStringProperty);
    Id_GetDRTTIStringProperty := LastSubId;
    RegisterRoutine(0, '', typeVOID, ccSTDCALL, @_GetDRTTIExtendedProperty);
    Id_GetDRTTIExtendedProperty := LastSubId;
    RegisterRoutine(0, '', typeVOID, ccSTDCALL, @_GetDRTTIVariantProperty);
    Id_GetDRTTIVariantProperty := LastSubId;
    RegisterRoutine(0, '', typeVOID, ccSTDCALL, @_GetDRTTIInt64Property);
    Id_GetDRTTIInt64Property := LastSubId;
    RegisterRoutine(0, '', typeVOID, ccSTDCALL, @_SetDRTTIProperty);
    Id_SetDRTTIProperty := LastSubId;

    H := RegisterRecordType(Level, 'TValue', 1);
    H_TValue := H;
    RegisterTypeField(H, 'dummy1', typeINT64);
    RegisterTypeField(H, 'dummy2', typeINT64);
    RegisterTypeField(H, 'dummy3', typeINT64);

    RegisterHeader(H, 'function GetDataSize: Integer;',
      @ TValue_GetDataSize);

    RegisterHeader(H, 'class operator Implicit(const Value: string): TValue;',
      @ TValue_Implicit_String);

    RegisterHeader(H, 'class operator Implicit(Value: Extended): TValue;',
      @ TValue_Implicit_Extended);

    RegisterHeader(H, 'class operator Implicit(Value: Int64): TValue;',
      @ TValue_Implicit_Int64);

    RegisterHeader(H, 'class operator Implicit(Value: TObject): TValue;',
      @ TValue_Implicit_TObject);

    RegisterHeader(H, 'class operator Implicit(Value: TClass): TValue;',
      @ TValue_Implicit_TClass);

    RegisterHeader(H, 'class operator Implicit(Value: Boolean): TValue;',
      @ TValue_Implicit_Boolean);

    RegisterHeader(H, 'class operator Implicit(Value: Integer): TValue;',
      @ TValue_Implicit_Integer);
    Id_ImplicitInt := LastSubId;

    RegisterHeader(H, 'class function FromVariant(const Value: Variant): TValue; static;',
      @TValue.FromVariant);

//    class function From<T>(const Value: T): TValue; static;
    RegisterHeader(H, 'class function FromOrdinal(ATypeInfo: Pointer; AValue: Int64): TValue; static;',
      @TValue.FromOrdinal);

    RegisterHeader(H, 'class function FromArray(ArrayTypeInfo: Pointer; const Values: array of TValue): TValue; static;',
      @TValue.FromArray);

    // Easy out
    //property Kind: TTypeKind read GetTypeKind;
    //property TypeInfo: PTypeInfo read GetTypeInfo;
    //property TypeData: PTypeData read GetTypeDataProp;
    //property IsEmpty: Boolean read GetIsEmpty;

    RegisterHeader(H, 'function IsObject: Boolean;',
      @TValue.IsObject);
    RegisterHeader(H, 'function AsObject: TObject;',
      @TValue.AsObject);
    RegisterHeader(H, 'function IsInstanceOf(AClass: TClass): Boolean;',
      @TValue.IsInstanceOf);
    RegisterHeader(H, 'function IsClass: Boolean;',
      @TValue.IsClass);
    RegisterHeader(H, 'function AsClass: TClass;',
      @TValue.AsClass);
    RegisterHeader(H, 'function IsOrdinal: Boolean;',
      @ TValue.IsOrdinal);
    RegisterHeader(H, 'function AsOrdinal: Int64;',
      @TValue.AsOrdinal);
    RegisterHeader(H, 'function TryAsOrdinal(out AResult: Int64): Boolean;',
      @TValue.TryAsOrdinal);

    // TValue -> concrete type
    // IsType returns true if AsType or Cast would succeed
    // AsType / Cast are only for what would normally be implicit conversions in Delphi.

    // function IsType<T>: Boolean; overload;
    // function IsType(ATypeInfo: PTypeInfo): Boolean; overload;
    // function AsType<T>: T;
    // function TryAsType<T>(out AResult: T): Boolean;

    // TValue -> TValue conversions
    // function Cast<T>: TValue; overload;
    // function Cast(ATypeInfo: PTypeInfo): TValue; overload;
    // function TryCast(ATypeInfo: PTypeInfo; out AResult: TValue): Boolean;

    RegisterHeader(H, 'function AsInteger: Integer;',
      @TValue.AsInteger);
    RegisterHeader(H, 'function AsBoolean: Boolean;',
      @TValue.AsBoolean);
    RegisterHeader(H, 'function AsExtended: Extended;',
      @TValue.AsExtended);
    RegisterHeader(H, 'function AsInt64: Int64;',
      @TValue.AsInt64);
    RegisterHeader(H, 'function AsInterface: IInterface;',
      @TValue.AsInterface);
    RegisterHeader(H, 'function AsInt64: Int64;',
      @TValue.AsInt64);
    RegisterHeader(H, 'function AsString: String;',
      @TValue.AsString);
    RegisterHeader(H, 'function AsVariant: Variant;',
      @TValue.AsVariant);
    RegisterHeader(H, 'function AsCurrency: Currency;',
      @TValue.AsCurrency);
    RegisterHeader(H, 'function IsArray: Boolean;',
      @TValue.IsArray);

    RegisterHeader(H, 'function GetArrayLength: Integer;',
      @TValue.GetArrayLength);
    RegisterHeader(H, 'function GetArrayElement(Index: Integer): TValue;',
      @TValue.GetArrayElement);
    RegisterHeader(H, 'procedure SetArrayElement(Index: Integer; const AValue: TValue);',
      @TValue.SetArrayElement);

    // Low-level in
    //class procedure Make(ABuffer: Pointer; ATypeInfo: PTypeInfo; out Result: TValue); overload; static;
    //class procedure MakeWithoutCopy(ABuffer: Pointer; ATypeInfo: PTypeInfo; out Result: TValue); overload; static;
    //class procedure Make(AValue: NativeInt; ATypeInfo: PTypeInfo; out Result: TValue); overload; static;

    // Low-level out
    RegisterHeader(H, 'property DataSize: Integer read GetDataSize;', nil);

    RegisterHeader(H, 'procedure ExtractRawData(ABuffer: Pointer);',
      @TValue.ExtractRawData);
    // If internal data is something with lifetime management, this copies a
    // reference out *without* updating the reference count.
    RegisterHeader(H, 'procedure ExtractRawDataNoCopy(ABuffer: Pointer);',
      @TValue.ExtractRawDataNoCopy);

    RegisterHeader(H, 'function GetReferenceToRawData: Pointer;',
      @TValue.GetReferenceToRawData);
    RegisterHeader(H, 'function GetReferenceToRawArrayElement(Index: Integer): Pointer;',
      @TValue.GetReferenceToRawArrayElement);

    RegisterHeader(H, 'function ToString: string;',
      @TValue.ToString);
  end;
end;

procedure InitializePAXCOMP_2010Reg;
begin
  RegisterDRTTIProperties := RegisterDRTTIPropertiesImpl;
  // Set event to get the namespace of a type.
  GetNamespaceOfType := GetNamespaceOfTypeImpl;
  AddPropInfosDRTTI := AddPropInfosDRTTIImpl;
  Import_TValue := Import_TValueImpl;
end;

initialization
  InitializePAXCOMP_2010Reg;
{$else}
implementation
{$endif}
end.

